home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0048_One Month Calendar.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  6KB  |  157 lines
  1. {
  2. A couple of weeks ago, my computer science had to write a computer program
  3. to generate a calendar.  Now my assignment is to incorporate the use of
  4. appropriate enumeration and subrange data types, and corresponding procedures
  5. to support these, into the program as a way of improving it.  Here is the
  6. program that I would like some suggestions on.. Thanks in advance:
  7. }
  8. program OneMonthCalendar ( INPUT, OUTPUT ) ;
  9.  
  10. var
  11.     Month : INTEGER ;  (* The month number;  a value in the range 1 - 12 *) 
  12.     PrevMonthDays : INTEGER ;  (* The number of days in the previous month *) 
  13.     CurrMonthDays : INTEGER ;  (* The number of days in the desired month *) 
  14.     StartDay : INTEGER ;  (* A value indicating the day of the week on    *)
  15.                           (* which the month begins;  0 = Sunday, 1 =    *)
  16.                           (* Monday, etc *) 
  17.     Date : INTEGER ;  (* The data currently being generated *) 
  18.  
  19. (*----------------------------------------------------------*)
  20. (*----------------------------------------------------------*)
  21.  
  22. procedure ReadData
  23.     ( var MonthNumber : INTEGER (* out - The month number *) ;
  24.       var PreviousMonthDays : INTEGER (* out - Number of days in the previous 
  25.                                         month *) ;
  26.       var CurrentMonthDays : INTEGER (* out - Number of days in the desired 
  27.                                         month *) ;
  28.       var StartingDay : INTEGER (* out - The day of the week on which the
  29.                                          desired month begins *) ) ;
  30.     begin (* procedure *)
  31.      Read ( MonthNumber ) ;
  32.      Read ( PreviousMonthDays ) ;
  33.      Read ( CurrentMonthDays ) ;
  34.      Read ( StartingDay ) ;
  35.      ReadLn;
  36.     end  (* ReadData *) ;
  37.  
  38. (*----------------------------------------------------------*)
  39.  
  40. procedure WriteHeading
  41.     (  Month : INTEGER (* in - The month number *) ) ;
  42.  
  43.     begin (* procedure *)
  44.      WriteLn;
  45.      WriteLn ( 'Month ', Month:2);
  46.      WriteLn ( '+----------------------+');
  47.      WriteLn ( '|  S  M  T  W  T  F  S |');
  48.      WriteLn ( '+----------------------+');
  49.     end  (* WriteHeading *) ;
  50.  
  51.   (*----------------------------------------------------------*)
  52.  
  53.   procedure WriteTrailing;
  54.    
  55.        
  56.    
  57.       begin (* procedure *)
  58.        WriteLn ('+----------------------+');
  59.       end  (* WriteTrailing *) ;
  60.    
  61. (*----------------------------------------------------------*)
  62.  
  63. procedure IncrementDate
  64.  
  65.     ( var Date : INTEGER (* in out - The date value to be incremented *) ;
  66.        DateLimit : INTEGER (* in - The number of days in the month
  67.                                    corresponding to the given date value *)
  68.                           );
  69.     begin (* procedure *)
  70.      if Date < DateLimit then begin
  71.          Date := Date + 1 ;
  72.      end else begin
  73.           Date := 1
  74.      end  (* if *) ;
  75.     end  (* IncrementDate *) ;
  76.  
  77. (*----------------------------------------------------------*)
  78.  
  79. procedure OneDayCalendar
  80.     (  Date : INTEGER (* in - The date value for the day *) ) ;
  81.  
  82.     begin (* procedure *)
  83.      Write ( Date:3 ) ;
  84.     end  (* OneDayCalendar *) ;
  85.  
  86. (*----------------------------------------------------------*)
  87.  
  88. procedure OneWeekCalendar
  89.     ( var Date : INTEGER (* in out - The date value *) ;
  90.        MonthsLastDate : INTEGER (* in - The date value of the last day   *)
  91.                        (* in the month corresponding to the    *)
  92.                        (* given date value *) ) ;
  93.  
  94.     var
  95.        Day : INTEGER ;(* Counting variable *) 
  96.        
  97.     begin (* procedure *)
  98.      Write ('|');
  99.      for Day := 1 to 7 do begin
  100.         OneDayCalendar ( Date ) ;
  101.         IncrementDate ( Date, MonthsLastDate ) ;
  102.        (* Day's value represents the number of dates outputed *)
  103.      end  (* for *) ;
  104.      WriteLn (' |');
  105.     end  (* OneWeekCalendar *) ;
  106.  
  107. (*----------------------------------------------------------*)
  108.  
  109. procedure DetermineSundayDate
  110.     (  PreviousMonthDays : INTEGER (* in - The number of days in the    *)
  111.                           (* previous month *) ;
  112.        StartingDay : INTEGER (* in - A value representing the day of the *)
  113.                     (* week on which the desired month begins *) ;
  114.       var SundayDate : INTEGER (* out - The date of the Sunday for the    *)
  115.                       (* first week in the calendar *) ) ;
  116.  
  117.     begin (* procedure *)
  118.      SundayDate := PreviousMonthDays - StartingDay;
  119.      IncrementDate (SundayDate, PreviousMonthDays);
  120.     end  (* DetermineSundayDate *) ;
  121.  
  122. (*----------------------------------------------------------*)
  123.  
  124. procedure GenerateCalendar
  125.     (  Date : INTEGER (* in - The starting date *) ;
  126.        PreviousMonth : INTEGER (* in - The number of days in the previous
  127.                                        month *) ;
  128.        CurrentMonth : INTEGER (* in - The number of days in the current
  129.                                       month *) ) ;
  130.  
  131.     var
  132.         PreviousSunday : INTEGER ;  (* The date of the previous sunday *)
  133.  
  134.     begin (* procedure *)
  135.       OneWeekCalendar ( Date, PreviousMonth ) ;
  136.       PreviousSunday := Date;
  137.       while Date >= PreviousSunday do begin
  138.          PreviousSunday := Date;
  139.          OneWeekCalendar ( Date, CurrentMonth ) ;
  140.       end  (* while *) ;
  141.     end  (* GenerateCalendar *) ;
  142.  
  143. (*=======================================================================*)
  144.  
  145. begin (* main program *)
  146.     WriteLn ('One Month Calendar - Version 4');  WriteLn;
  147.     while NOT EOF do begin
  148.        ReadData ( Month, PrevMonthDays, CurrMonthDays, StartDay ) ;
  149.        WriteHeading (Month);
  150.        DetermineSundayDate (PrevMonthDays, StartDay, Date);
  151.        GenerateCalendar (Date, PrevMonthDays, CurrMonthDays);
  152.        WriteTrailing;
  153.        (* EOLN is true *)
  154.     end  (* while *) ;
  155. end (* OneMonthCalendar *).
  156.  
  157.